library(corrplot)
library(corrgram)
library(skimr)
library(knitr)
library(ggplot2)
library(dplyr)
library(formattable)
library(randomForest)
library(caret)
library(readr)
library(gmodels)
library(rpart)
library(rpart.plot)
library(polycor)
library(cluster)
library(fpc)

1 Introdução

Esta análise aplica-se a um dataset de variantes do vinho portugues “Vinho Verde”, possuindo diversos indicadores de suas caracteristicas, como acidez, teor alcoolico, quantidade de açucar, entre outros…

2 Carregando dados

vinhos <- read.csv("BaseWine_Red_e_White.csv", header = TRUE, sep = ";", dec = ",")

3 Análise Exploratória dos Dados

3.1 Conhecendo as variaveis

3.1.1 Sumario da Base original

summary(vinhos)

##     id_vinho     fixedacidity    volatileacidity    citricacid    
##  Min.   :   1   Min.   : 3.800   Min.   :0.0800   Min.   :0.0000  
##  1st Qu.:1625   1st Qu.: 6.400   1st Qu.:0.2300   1st Qu.:0.2500  
##  Median :3249   Median : 7.000   Median :0.2900   Median :0.3100  
##  Mean   :3249   Mean   : 7.215   Mean   :0.3397   Mean   :0.3186  
##  3rd Qu.:4873   3rd Qu.: 7.700   3rd Qu.:0.4000   3rd Qu.:0.3900  
##  Max.   :6497   Max.   :15.900   Max.   :1.5800   Max.   :1.6600  
##  residualsugar     chlorides       freesulfurdioxide totalsulfurdioxide
##  Min.   : 0.60   Min.   :0.00900   Min.   :  1.00    Min.   :  6.0     
##  1st Qu.: 1.80   1st Qu.:0.03800   1st Qu.: 17.00    1st Qu.: 77.0     
##  Median : 3.00   Median :0.04700   Median : 29.00    Median :118.0     
##  Mean   : 5.44   Mean   :0.05603   Mean   : 30.53    Mean   :115.7     
##  3rd Qu.: 8.10   3rd Qu.:0.06500   3rd Qu.: 41.00    3rd Qu.:156.0     
##  Max.   :45.80   Max.   :0.61100   Max.   :289.00    Max.   :440.0     
##     density             pH          sulphates         alcohol       
##  Min.   :0.9871   Min.   :2.720   Min.   :0.2200   Min.   : 0.9567  
##  1st Qu.:0.9923   1st Qu.:3.110   1st Qu.:0.4300   1st Qu.: 9.5000  
##  Median :0.9949   Median :3.210   Median :0.5100   Median :10.3000  
##  Mean   :0.9947   Mean   :3.219   Mean   :0.5313   Mean   :10.4862  
##  3rd Qu.:0.9970   3rd Qu.:3.320   3rd Qu.:0.6000   3rd Qu.:11.3000  
##  Max.   :1.0140   Max.   :4.010   Max.   :2.0000   Max.   :14.9000  
##     quality        Vinho     
##  Min.   :3.000   RED  :1599  
##  1st Qu.:5.000   WHITE:4898  
##  Median :6.000               
##  Mean   :5.818               
##  3rd Qu.:6.000               
##  Max.   :9.000

str(vinhos)

## 'data.frame':    6497 obs. of  14 variables:
##  $ id_vinho          : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ fixedacidity      : num  6.6 6.7 10.6 5.4 6.7 6.8 6.6 7.2 5.1 6.2 ...
##  $ volatileacidity   : num  0.24 0.34 0.31 0.18 0.3 0.5 0.61 0.66 0.26 0.22 ...
##  $ citricacid        : num  0.35 0.43 0.49 0.24 0.44 0.11 0 0.33 0.33 0.2 ...
##  $ residualsugar     : num  7.7 1.6 2.2 4.8 18.8 ...
##  $ chlorides         : num  0.031 0.041 0.063 0.041 0.057 0.075 0.069 0.068 0.027 0.035 ...
##  $ freesulfurdioxide : num  36 29 18 30 65 16 4 34 46 58 ...
##  $ totalsulfurdioxide: num  135 114 40 113 224 49 8 102 113 184 ...
##  $ density           : num  0.994 0.99 0.998 0.994 1 ...
##  $ pH                : num  3.19 3.23 3.14 3.42 3.11 3.36 3.33 3.27 3.35 3.11 ...
##  $ sulphates         : num  0.37 0.44 0.51 0.4 0.53 0.79 0.37 0.78 0.43 0.53 ...
##  $ alcohol           : num  10.5 12.6 9.8 9.4 9.1 9.5 10.4 12.8 11.4 9 ...
##  $ quality           : int  5 6 6 6 5 5 4 6 7 6 ...
##  $ Vinho             : Factor w/ 2 levels "RED","WHITE": 2 2 1 2 2 1 1 1 2 2 ...

Dataset com 13 variaveis, dentre elas a variável “quality” indica a qualidade medida de cada vinho.

fixedacidity: Indica a quantidade de acidos presente no vinho (voláteis ou não voláteis);
volatileacidity: Indica a quantidade de ácido acético no vinho, que em níveis muito altos pode levar a um gosto desagradável de vinagre;
citricacid: Indica a quantidade de ácido cítrico, pode adicionar “frescura” e sabor aos vinhos;
residualsugar: Indica a quantidade de açúcar restante depois que o processo de fermentação;
chlorides: Indica a quantidade de sal no vinho;
freesulfurdioxide: Indica a quantidade da forma livre de SO2, impede o crescimento microbiano e a oxidação do vinho, Garante condições melhores para os processos de vinificação da bebida, elimina bactérias e leveduras frágeis e indesejáveis, o que permite que apenas as melhores prossigam com o processo fermentativo. Além do mais, melhora o aroma e afina a cor da bebida;
totalsulfurdioxide: Indica a quantidade de formas livres e encadernadas de S02; em baixas concentrações, o SO2 é quase indetectável no vinho, mas nas concentrações de SO2 livre acima de 50 ppm, o SO2 se torna evidente no nariz e no sabor do vinho;
density:indica a densidade do vinho, a densidade é próxima à da água, dependendo do percentual de álcool e teor de açúcar;
pH: descreve como o vinho é acídico ou básico numa escala de 0 (muito ácido) a 14 (muito básico); a maioria dos vinhos tem entre 3-4 na escala de pH;
sulphates: Indica a quantidade de sulfatos, um aditivo de vinho que pode contribuir para os níveis de gás de dióxido de enxofre (S02), que age como um antimicrobiano e antioxidante;
alcohol: Indica o teor alcoólico percentual do vinho;
quality: variável de saída (com base em dados sensoriais) que poderiam ser de 0 a 10 sendo zero muito ruim e 10 muito excelente;
Vinho: variável qualitativa nominal que indica se o vinho é tinto ou branco.

3.2 Verificação da completude da amostra

É importante averiguarmos a existẽncia de dados incompletos na amostra de modo que possam influenciar a análise e o desenvolvimento dos modelos estatísticos:

skim(vinhos) %>% skimr::kable()

Skim summary statistics
n obs: 6497
n variables: 14

Variable type: factor

variable	missing	complete	n	n_unique	top_counts	ordered
Vinho	0	6497	6497	2	WHI: 4898, RED: 1599, NA: 0	FALSE

Variable type: integer

variable	missing	complete	n	mean	sd	p0	p25	p50	p75	p100	hist
id_vinho	0	6497	6497	3249	1875.67	1	1625	3249	4873	6497	▇▇▇▇▇▇▇▇
quality	0	6497	6497	5.82	0.87	3	5	6	6	9	▁▁▆▇▁▃▁▁

Variable type: numeric

variable	complete	n	mean	sd	p0	p25	p50	p75	p100	hist
alcohol	6497	6497	10.49	1.22	0.96	9.5	10.3	11.3	14.9	▁▁▁▁▆▇▃▁
chlorides	6497	6497	0.056	0.035	0.009	0.038	0.047	0.065	0.61	▇▁▁▁▁▁▁▁
citricacid	6497	6497	0.32	0.15	0	0.25	0.31	0.39	1.66	▂▇▂▁▁▁▁▁
density	6497	6497	0.99	0.003	0.99	0.99	0.99	1	1.01	▂▇▇▅▁▁▁▁
fixedacidity	6497	6497	7.22	1.3	3.8	6.4	7	7.7	15.9	▁▇▇▂▁▁▁▁
freesulfurdioxide	6497	6497	30.53	17.75	1	17	29	41	289	▇▃▁▁▁▁▁▁
pH	6497	6497	3.22	0.16	2.72	3.11	3.21	3.32	4.01	▁▃▇▇▃▁▁▁
residualsugar	6497	6497	5.44	4.73	0.6	1.8	3	8.1	45.8	▇▂▂▁▁▁▁▁
sulphates	6497	6497	0.53	0.15	0.22	0.43	0.51	0.6	2	▅▇▂▁▁▁▁▁
totalsulfurdioxide	6497	6497	115.74	56.52	6	77	118	156	440	▅▆▇▃▁▁▁▁
volatileacidity	6497	6497	0.34	0.16	0.08	0.23	0.29	0.4	1.58	▇▇▂▁▁▁▁▁

3.3 Detectando Outliers

Outliers são observações que apresentam grandes afastamentos das demais e/ou são inconsistentes com estas. Um bom método de verificar a existência de outliers é a análise gráfica, através de um histograma sobreposto pela distribuição normal e duas linhas que delimitem o limite mínimo e máximo de corte, também é usado o gráfico bloxpot.

hist.default <- function(x,
                         breaks = "Sturges",
                         freq = NULL,
                         include.lowest = TRUE,
                         normalcurve = TRUE,
                         right = TRUE,
                         density = NULL,
                         angle = 45,
                         col = NULL,
                         border = NULL,
                         main = paste("Histogram of", xname),
                         ylim = NULL,
                         xlab = xname,
                         ylab = NULL,
                         axes = TRUE,
                         plot = TRUE,
                         labels = FALSE,
                         warn.unused = TRUE,
                         ...)  {
  xname <- paste(deparse(substitute(x), 500), collapse = "\n")

  suppressWarnings(
    h <- graphics::hist.default(
      x = x,
      breaks = breaks,
      freq = freq,
      include.lowest = include.lowest,
      right = right,
      density = density,
      angle = angle,
      col = col,
      border = border,
      main = main,
      ylim = ylim,
      xlab = xlab,
      ylab = ylab,
      axes = axes,
      plot = plot,
      labels = labels,
      warn.unused = warn.unused,
      ...
    )
  )

  if (normalcurve == TRUE & plot == TRUE) {
    x <- x[!is.na(x)]
    xfit <- seq(min(x), max(x), length = 40)
    yfit <- dnorm(xfit, mean = mean(x), sd = sd(x))
    if (isTRUE(freq) | (is.null(freq) & is.null(density))) {
      yfit <- yfit * diff(h$mids[1:2]) * length(x)
    }
    lines(xfit, yfit, col = "black", lwd = 2)
  }

  if (plot == TRUE) {
    invisible(h)
  } else {
    h
  }
}

plotaGraficos <- function(fVinho, label){
par(mfrow = c(1,2))
hist(fVinho, main = paste("Histograma de ",label), xlab = label, ylab="Frequência")
abline(v = mean(fVinho) - 2 * sd(fVinho), col = "red")
abline(v = mean(fVinho) + 2 * sd(fVinho), col = "red")
boxplot(fVinho)
}

plotaGraficos(vinhos$fixedacidity, "fixedacidity")

plotaGraficos(vinhos$volatileacidity, "volatileacidity")

plotaGraficos(vinhos$citricacid, "citricacid")

plotaGraficos(vinhos$residualsugar, "residualsugar")

plotaGraficos(vinhos$chlorides, "chlorides")

plotaGraficos(vinhos$freesulfurdioxide, "freesulfurdioxide")

plotaGraficos(vinhos$totalsulfurdioxide, "totalsulfurdioxide")

plotaGraficos(vinhos$density, "density")

plotaGraficos(vinhos$pH, "pH")

plotaGraficos(vinhos$sulphates, "sulphates")

plotaGraficos(vinhos$alcohol, "alcohol")

3.4 Removendo Outliers

Pelo boxplot é possível visualizar que há grupos distintos de vinhos dadas as características físico-químicas e a qualidade entre eles, mas também é possível notar que nas variáveis “residualsugar”, “freesilfurdioxide” e “totalsulfurdioxide” existem observações com valores muito distantes dos agrupamentos no gráfico e consideramos estas possíveis outliers, sendo assim, serão removidos para que não interfiram no resultado da análise e dos algoritmos

vinhos <- vinhos%>%filter(residualsugar < 40)
vinhos <- vinhos%>%filter(freesulfurdioxide < 200)
vinhos <- vinhos%>%filter(totalsulfurdioxide < 400)

plotaGraficos(vinhos$residualsugar, "residualsugar")

plotaGraficos(vinhos$freesulfurdioxide, "freesulfurdioxide")

plotaGraficos(vinhos$totalsulfurdioxide, "totalsulfurdioxide")

4 Correlação de variaveis

Gerando a correlação das variaveis, vai permitir o entendimento de quais carácteristicas estão mais relacionadas a nota de qualidade dadas aos vinho.

Vamos começar pela matriz de correlação.

4.1 Matriz de Correlação

Matriz de correlação mostra os valores de correlação de Pearson, que medem o grau de relação linear entre cada par de itens ou variáveis. Os valores de correlação podem cair entre -1 e +1.

matcor <- cor(vinhos%>%select(2:13))
panel.cor <- function(x, y, digits=2, prefix ="", cex.cor,
                      ...)  {
  usr <- par("usr")
  on.exit(par(usr))
  par(usr = c(0, 1, 0, 1))
  r <- cor(x, y , use = "pairwise.complete.obs")
  txt <- format(c(r, 0.123456789), digits = digits) [1]
  txt <- paste(prefix, txt, sep = "")
  if (missing(cex.cor))
    cex <- 0.8/strwidth(txt)
  text(0.5, 0.5, txt, cex = cex * abs(r))
}
pairs(vinhos%>%select(2:13), lower.panel=panel.smooth, upper.panel=panel.cor)

4.1.1 Conclusão

A Qualidade dos vinhos apresenta correlação com o teor alcoólico, densidade e acidez volátil, ainda que não seja um alto grau de correlação, porém, outras variáveis do dataset apresentam alta correlação entre si.

4.2 Estimando a qualidade do vinho

Tendo como alvo a qualidade dos vinhos, usaremos as características físico-químicas dos mesmos e usaremos duas técnicas diferentes para obtermos nossa variável de resposta.

4.2.1 Regressão Linear

A regressão linear consiste em uma função que relaciona as variáveis que contém características do objeto de estudo a uma varíavel depente do mesmo objeto de estudo, gerando assim uma relação entre o resultado observado às suas possíveis explicações.

Usaremos o método stepwise no desenvolvimento do modelo, selecionando assim as variáveis que melhor estimem a qualidade do vinho

vinhos_rl <- vinhos%>%select(2:13)
modelo_rl <- lm(vinhos$quality ~ vinhos_rl$fixedacidity + vinhos_rl$volatileacidity + vinhos_rl$citricacid + vinhos_rl$residualsugar + vinhos_rl$chlorides + vinhos_rl$freesulfurdioxide + vinhos_rl$totalsulfurdioxide + vinhos_rl$density + vinhos_rl$pH + vinhos_rl$sulphates + vinhos_rl$alcohol)
stepwise<-step(modelo_rl,direction="both")

## Start:  AIC=-3954.3
## vinhos$quality ~ vinhos_rl$fixedacidity + vinhos_rl$volatileacidity + 
##     vinhos_rl$citricacid + vinhos_rl$residualsugar + vinhos_rl$chlorides + 
##     vinhos_rl$freesulfurdioxide + vinhos_rl$totalsulfurdioxide + 
##     vinhos_rl$density + vinhos_rl$pH + vinhos_rl$sulphates + 
##     vinhos_rl$alcohol
## 
##                                Df Sum of Sq    RSS     AIC
## - vinhos_rl$citricacid          1     0.963 3521.2 -3954.5
## - vinhos_rl$chlorides           1     0.977 3521.2 -3954.5
## <none>                                      3520.2 -3954.3
## - vinhos_rl$fixedacidity        1    25.207 3545.4 -3910.0
## - vinhos_rl$pH                  1    25.430 3545.6 -3909.5
## - vinhos_rl$density             1    31.458 3551.6 -3898.5
## - vinhos_rl$freesulfurdioxide   1    43.014 3563.2 -3877.4
## - vinhos_rl$totalsulfurdioxide  1    54.672 3574.9 -3856.2
## - vinhos_rl$residualsugar       1    63.273 3583.5 -3840.6
## - vinhos_rl$sulphates           1    69.150 3589.3 -3830.0
## - vinhos_rl$alcohol             1    91.819 3612.0 -3789.1
## - vinhos_rl$volatileacidity     1   139.605 3659.8 -3703.7
## 
## Step:  AIC=-3954.52
## vinhos$quality ~ vinhos_rl$fixedacidity + vinhos_rl$volatileacidity + 
##     vinhos_rl$residualsugar + vinhos_rl$chlorides + vinhos_rl$freesulfurdioxide + 
##     vinhos_rl$totalsulfurdioxide + vinhos_rl$density + vinhos_rl$pH + 
##     vinhos_rl$sulphates + vinhos_rl$alcohol
## 
##                                Df Sum of Sq    RSS     AIC
## <none>                                      3521.2 -3954.5
## + vinhos_rl$citricacid          1     0.963 3520.2 -3954.3
## - vinhos_rl$chlorides           1     1.340 3522.5 -3954.1
## - vinhos_rl$fixedacidity        1    24.317 3545.5 -3911.8
## - vinhos_rl$pH                  1    26.135 3547.3 -3908.5
## - vinhos_rl$density             1    31.387 3552.5 -3898.9
## - vinhos_rl$freesulfurdioxide   1    43.318 3564.5 -3877.1
## - vinhos_rl$totalsulfurdioxide  1    58.696 3579.9 -3849.1
## - vinhos_rl$residualsugar       1    62.815 3584.0 -3841.7
## - vinhos_rl$sulphates           1    68.509 3589.7 -3831.4
## - vinhos_rl$alcohol             1    90.915 3612.1 -3791.0
## - vinhos_rl$volatileacidity     1   153.190 3674.3 -3679.9

summary(stepwise)

## 
## Call:
## lm(formula = vinhos$quality ~ vinhos_rl$fixedacidity + vinhos_rl$volatileacidity + 
##     vinhos_rl$residualsugar + vinhos_rl$chlorides + vinhos_rl$freesulfurdioxide + 
##     vinhos_rl$totalsulfurdioxide + vinhos_rl$density + vinhos_rl$pH + 
##     vinhos_rl$sulphates + vinhos_rl$alcohol)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.5625 -0.4657 -0.0423  0.4708  3.0081 
## 
## Coefficients:
##                                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                   9.185e+01  1.181e+01   7.779 8.44e-15 ***
## vinhos_rl$fixedacidity        1.008e-01  1.507e-02   6.692 2.39e-11 ***
## vinhos_rl$volatileacidity    -1.194e+00  7.111e-02 -16.796  < 2e-16 ***
## vinhos_rl$residualsugar       5.449e-02  5.066e-03  10.755  < 2e-16 ***
## vinhos_rl$chlorides          -5.181e-01  3.299e-01  -1.571    0.116    
## vinhos_rl$freesulfurdioxide   6.859e-03  7.680e-04   8.931  < 2e-16 ***
## vinhos_rl$totalsulfurdioxide -2.832e-03  2.724e-04 -10.396  < 2e-16 ***
## vinhos_rl$density            -9.163e+01  1.205e+01  -7.602 3.32e-14 ***
## vinhos_rl$pH                  6.225e-01  8.973e-02   6.937 4.38e-12 ***
## vinhos_rl$sulphates           8.525e-01  7.590e-02  11.232  < 2e-16 ***
## vinhos_rl$alcohol             2.081e-01  1.608e-02  12.939  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7369 on 6484 degrees of freedom
## Multiple R-squared:  0.288,  Adjusted R-squared:  0.2869 
## F-statistic: 262.3 on 10 and 6484 DF,  p-value: < 2.2e-16

Através da sumarização do modelo podemos observar que a quantidade de sal presente nos vinhos não é relevante para a estimarmos a qualidade e será removida da modelo final

modelo_rl_final <- lm(vinhos_rl$quality ~ vinhos_rl$fixedacidity + vinhos_rl$volatileacidity + vinhos_rl$citricacid + vinhos_rl$residualsugar + vinhos_rl$freesulfurdioxide + vinhos_rl$totalsulfurdioxide + vinhos_rl$density + vinhos_rl$pH + vinhos_rl$sulphates + vinhos_rl$alcohol)

4.2.1.1 Análise de resíduos

Com o gráfico abaixo podemos concluir que os resíduos da predição com o modelo desenvolvido que a premissa de normalidade é atendida:

qqnorm(residuals(modelo_rl_final), ylab="Resíduos",xlab="Quantis teóricos",main="")
qqline(residuals(modelo_rl_final))

Concluímos que com o modelo de regressão desenvolvido temos um erro quadrático médio de aproximadamente 0,74.

pred <- predict(modelo_rl_final,interval = "prediction", level = 0.95)

## Warning in predict.lm(modelo_rl_final, interval = "prediction", level = 0.95): predictions on current data refer to _future_ responses

fit <- pred[,1]
mse <- mean((vinhos_rl$quality  - fit)^2)
sqrt(mse)

## [1] 0.7362984

4.2.2 Árvore de Regressão

Árvores de Regressão são idênticas às árvores de decisão porém para variáveis escalares, na figura abaixo está a plotagem de uma árvore de regressão de 9 níveis na qual as folhas agrupam os vinhos por sua qualidade, o split do algoritmo foi setado em 325 que é aproximadamente o valor de 5% da amostra. Com este este algorimo atingimos um erro quadrático médio de aproximadamente 0,71.

modelo_arvore <- rpart(quality ~ fixedacidity + volatileacidity + citricacid + residualsugar + chlorides + freesulfurdioxide + totalsulfurdioxide + density + pH + sulphates + alcohol, data=vinhos_rl, 
                     cp = 0.001,minsplit = 325,maxdepth=20)

rpart.plot(modelo_arvore, type=4, extra=1, under=FALSE, clip.right.labs=TRUE,
           fallen.leaves=FALSE,   digits=2, varlen=-10, faclen=20,
           cex=0.4, tweak=1.7,
           compress=TRUE, 
           snip=FALSE)

## Warning: labs do not fit even at cex 0.15, there may be some overplotting

## Warning: cex and tweak both specified, applying both

pred_arvore <- predict(modelo_arvore,interval = "prediction", level = 0.95) 
mse_tree <- mean((vinhos_rl$quality  - pred_arvore)^2)
sqrt(mse_tree)

## [1] 0.7087093

Assim concluímos que entre os dois algoritmos apresentados o de melhor desempenho foi a Árvore de Regressão ainda que com uma diferença muito pequena entre eles.

4.3 Classificando entre bons e ruins

Tendo em mente que os vinhos com nota superior igual à 6 sãos classificados com bons e os inferiores à isso são classificados como ruins podemos criar uma variável qualitativa e criarmos uma nova variável no dataset e trabalharmos sobre os dados que levam a esta classificação.

vinhos_class <- vinhos%>%
                select(2:14)%>%
                mutate(Qualidade = ifelse(quality >= 6, "BOM", "RUIM"))%>%
                select(-quality)%>%
                select(-Vinho)
vinhos_class$Qualidade <- factor(vinhos_class$Qualidade)

summary(vinhos_class)

##   fixedacidity    volatileacidity    citricacid     residualsugar   
##  Min.   : 3.800   Min.   :0.0800   Min.   :0.0000   Min.   : 0.600  
##  1st Qu.: 6.400   1st Qu.:0.2300   1st Qu.:0.2500   1st Qu.: 1.800  
##  Median : 7.000   Median :0.2900   Median :0.3100   Median : 3.000  
##  Mean   : 7.215   Mean   :0.3396   Mean   :0.3186   Mean   : 5.434  
##  3rd Qu.: 7.700   3rd Qu.:0.4000   3rd Qu.:0.3900   3rd Qu.: 8.100  
##  Max.   :15.900   Max.   :1.5800   Max.   :1.6600   Max.   :31.600  
##    chlorides       freesulfurdioxide totalsulfurdioxide    density      
##  Min.   :0.00900   Min.   :  1.00    Min.   :  6.0      Min.   :0.9871  
##  1st Qu.:0.03800   1st Qu.: 17.00    1st Qu.: 77.0      1st Qu.:0.9923  
##  Median :0.04700   Median : 29.00    Median :118.0      Median :0.9949  
##  Mean   :0.05603   Mean   : 30.49    Mean   :115.7      Mean   :0.9947  
##  3rd Qu.:0.06500   3rd Qu.: 41.00    3rd Qu.:156.0      3rd Qu.:0.9970  
##  Max.   :0.61100   Max.   :146.50    Max.   :366.5      Max.   :1.0103  
##        pH          sulphates         alcohol        Qualidade  
##  Min.   :2.720   Min.   :0.2200   Min.   : 0.9567   BOM :4112  
##  1st Qu.:3.110   1st Qu.:0.4300   1st Qu.: 9.5000   RUIM:2383  
##  Median :3.210   Median :0.5100   Median :10.3000              
##  Mean   :3.218   Mean   :0.5312   Mean   :10.4860              
##  3rd Qu.:3.320   3rd Qu.:0.6000   3rd Qu.:11.3000              
##  Max.   :4.010   Max.   :2.0000   Max.   :14.9000

4.3.1 Entendendo a relação das variáveis

Plotamos alguns gráficos para entendermos a relação das variáveis com a qualidade atribuída aos vinhos:

#comando para gerar em 4 linhas e duas colunas os plots
par (mfrow=c(1,2))
plot(vinhos_class$Qualidade, vinhos_class$fixedacidity,ylab="fixedacidity",xlab="Qualidade",col=c('red','darkgreen'))
plot(vinhos_class$Qualidade, vinhos_class$volatilacidity,ylab="volatilacidity",xlab="Qualidade",col=c('red','darkgreen'))

plot(vinhos_class$Qualidade, vinhos_class$citricacid,ylab="citricacid",xlab="Qualidade",col=c('red','darkgreen'))
plot(vinhos_class$Qualidade, vinhos_class$residualsugar,ylab="residualsugar",xlab="Qualidade",col=c('red','darkgreen'))

plot(vinhos_class$Qualidade, vinhos_class$chlorides,ylab="chlorides",xlab="Qualidade",col=c('red','darkgreen'))
plot(vinhos_class$Qualidade, vinhos_class$freesulfordioxide,ylab="freesulfordioxide",xlab="Qualidade",col=c('red','darkgreen'))

plot(vinhos_class$Qualidade, vinhos_class$totalsulfordioxide,ylab="totalsulfordioxide",xlab="Qualidade",col=c('red','darkgreen'))
plot(vinhos_class$Qualidade, vinhos_class$density,ylab="density",xlab="Qualidade",col=c('red','darkgreen'))

plot(vinhos_class$Qualidade, vinhos_class$pH,ylab="pH",xlab="Qualidade",col=c('red','darkgreen'))
plot(vinhos_class$Qualidade, vinhos_class$sulphates,ylab="sulphates",xlab="Qualidade",col=c('red','darkgreen'))

plot(vinhos_class$Qualidade, vinhos_class$alcohol,ylab="alcohol",xlab="Qualidade",col=c('red','darkgreen'))

Alguns dos gráficos como freesulfordioxide e totalsulfordioxide não trazem boa compreensão sobre a relação das variáveis com a qualidade.

Para averiguarmos melhor usaremos o corrplot para enxergarmos as correlações.

matcor <- hetcor(vinhos_class)
panel.cor <- function(x, y, digits=2, prefix ="", cex.cor,
                      ...)  {
  usr <- par("usr")
  on.exit(par(usr))
  par(usr = c(0, 1, 0, 1))
  r <- cor(x, y , use = "pairwise.complete.obs")
  txt <- format(c(r, 0.123456789), digits = digits) [1]
  txt <- paste(prefix, txt, sep = "")
  if (missing(cex.cor))
    cex <- 0.8/strwidth(txt)
  text(0.5, 0.5, txt, cex = cex * abs(r))
}
pairs(vinhos_class, lower.panel=panel.smooth, upper.panel=panel.cor)

As variáveis que apresentam os maiores graus de correção com a qualidade (BOM ou RUIM) ainda que negativas são teor alcólico, densidade e acidez volátil.

4.3.2 Categorizando os vinhos

A fim de categorizar os vinhos a partir de suas características utilizaremos as técnicas de regressão logística e árvore de decisão. Para o uso de tais técnicas dividiremos nosso dataset em 2/3 para o treinamento e 1/3 para a validação.

particao <- 2/3
set.seed(2019)
treino <- sample(1:NROW(vinhos_class), as.integer(particao*NROW(vinhos_class)))

trainData <- vinhos_class[treino,]
testData  <- vinhos_class[-treino,]

4.3.2.1 Árvore de decisão

Com o intuito de selecionarmos as variáveis que utilizaremos na regressão logística primeiros iremos usar a árvore de decisão para identificarmos quais variáveis se apresentam como critérios de decisão.

modelo_arvore_decisao <- rpart (Qualidade ~ fixedacidity + volatileacidity + citricacid  + residualsugar + chlorides + freesulfurdioxide + totalsulfurdioxide + density  + pH + sulphates + alcohol, data=trainData, cp = 0.006,minsplit = 325,maxdepth=20)
rpart.plot(modelo_arvore_decisao, type=4, extra=104, under=FALSE, clip.right.labs=TRUE,
           fallen.leaves=FALSE,   digits=2, varlen=-3, faclen=20,
           cex=0.4, tweak=1.7,
           compress=TRUE,
           snip=FALSE)

## Warning: cex and tweak both specified, applying both

qualidade_predita <- predict(modelo_arvore_decisao ,testData , type = "class")

matriz.de.confusao<-table(testData$Qualidade, qualidade_predita)
matriz.de.confusao

##       qualidade_predita
##         BOM RUIM
##   BOM  1140  231
##   RUIM  316  478

diagonal <- diag(matriz.de.confusao)
perc.erro <- 1 - sum(diagonal)/sum(matriz.de.confusao)
perc.erro

## [1] 0.2526559

Observamos pela matriz de confusão a assertividade do modelo e seu percentual de erro de aproximadamente 25%.

4.3.3 Regressão Logística

Assim como na regressão linear a regressão logística se baseia em váriáveis independentes para chegar a uma variável dependente, porém neste caso, uma variável categórica

modelo_log<-glm(Qualidade ~ fixedacidity + volatileacidity + citricacid  + residualsugar + chlorides + freesulfurdioxide + totalsulfurdioxide + density  + pH + sulphates + alcohol,trainData, family=binomial(link=logit))

predito<-fitted(modelo_log)
hist(predito)

fx_predito <- cut(predito, breaks=c(0,0.10,0.20,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1), right=F)
plot(fx_predito , trainData$Qualidade)

Predito_teste<-predict(modelo_log, testData)

fx_predito1 <- cut(Predito_teste, breaks=c(0,0.50,1), right=F)

MC <- table(testData$Qualidade,  fx_predito1 , deparse.level = 2)
show(MC)

##                   fx_predito1
## testData$Qualidade [0,0.5) [0.5,1)
##               BOM      105      63
##               RUIM     157     138

perc.erro.log = 1 - sum(diag(MC))/sum(MC) 
show(perc.erro.log )

## [1] 0.475162

Como podemos ver nos gráficos acima e também na matriz de confusão, o percentual de erro do modelo foi de aproximadamente 47%, o que nos leva a concluir que para a classificação dos vinhos entre BOM e RUIM o melhor método foi a Árvore de decisão.

4.4 Definindo grupos de vinhos

Para análise dos grupos de vinhos a partir de sua características físico-químicas iremos utilizar três técnicas, são elas: Clusteres Hierárquicos, Componentes principais e K-means.

vinhos_clusters <- vinhos%>%select(2:12)
matcor <- cor(vinhos_clusters)
panel.cor <- function(x, y, digits=2, prefix ="", cex.cor,
                      ...)  {
  usr <- par("usr")
  on.exit(par(usr))
  par(usr = c(0, 1, 0, 1))
  r <- cor(x, y , use = "pairwise.complete.obs")
  txt <- format(c(r, 0.123456789), digits = digits) [1]
  txt <- paste(prefix, txt, sep = "")
  if (missing(cex.cor))
    cex <- 0.8/strwidth(txt)
  text(0.5, 0.5, txt, cex = cex * abs(r))
}
pairs(vinhos_clusters, lower.panel=panel.smooth, upper.panel=panel.cor)

Como já observado anteriormente, algumas das variáveis do dataset apresentam forte correlação entre si como freesulfordioxide e totalsulfordioxide, outro exemplo de forte correlação é alcohol e density.

4.4.1 Componentes Principais

Esta técnica consiste no desenvolvimento de componentes de análise que representem as características dos dados sem que que sofre interferência das variáveis que possuem forte correlação entre elas, possibilitando assim um melhor desempenho dos modelos.

vinhos_clusters_padr <- scale(vinhos_clusters)
pcacor_vinhos <- prcomp(vinhos_clusters_padr, scale = TRUE) 
summary(pcacor_vinhos)

## Importance of components:
##                           PC1    PC2    PC3    PC4     PC5     PC6     PC7
## Standard deviation     1.7457 1.5796 1.2464 0.9833 0.84315 0.77705 0.72252
## Proportion of Variance 0.2771 0.2268 0.1412 0.0879 0.06463 0.05489 0.04746
## Cumulative Proportion  0.2771 0.5039 0.6451 0.7330 0.79763 0.85252 0.89998
##                            PC8     PC9    PC10    PC11
## Standard deviation     0.70529 0.58187 0.47916 0.18607
## Proportion of Variance 0.04522 0.03078 0.02087 0.00315
## Cumulative Proportion  0.94520 0.97598 0.99685 1.00000

plot(1:11, pcacor_vinhos$sdev^2, type = "b", xlab = "Componente", ylab = "Variância", pch = 20, cex.axis = 0.8, cex.lab = 0.8)

pcacor_vinhos$rotation[, 1:11]

##                            PC1         PC2         PC3        PC4
## fixedacidity        0.23910404 -0.33807511  0.43250569 -0.1709661
## volatileacidity     0.38097541 -0.11255471 -0.30693643 -0.2158823
## citricacid         -0.15188291 -0.18391604  0.59195923  0.2670538
## residualsugar      -0.34869935 -0.32675524 -0.16595686 -0.1541105
## chlorides           0.29082821 -0.31374730 -0.01715046  0.2393078
## freesulfurdioxide  -0.43193476 -0.07720060 -0.13494093  0.3472041
## totalsulfurdioxide -0.48509509 -0.08972628 -0.10821419  0.2051820
## density             0.04914824 -0.58341217 -0.17637712 -0.0641519
## pH                  0.21885812  0.16011307 -0.45145632  0.4231826
## sulphates           0.29435715 -0.18988071  0.07215266  0.6424321
## alcohol             0.09798390  0.46683382  0.26538696  0.1151572
##                           PC5         PC6         PC7          PC8
## fixedacidity        0.1664451  0.19792330  0.26625674 -0.394584106
## volatileacidity    -0.1628338  0.47736368  0.41029176  0.049366008
## citricacid          0.1419215 -0.23493031  0.38953049  0.267785308
## residualsugar       0.3324208  0.25422224 -0.18773526  0.553079395
## chlorides          -0.6289472 -0.16977181  0.06408220  0.454483200
## freesulfurdioxide  -0.2256297  0.31998541  0.29813097 -0.231397403
## totalsulfurdioxide -0.1633365  0.13998358  0.14232190 -0.156133912
## density             0.3083237 -0.01282956  0.04655075  0.008632912
## pH                  0.4556496 -0.29562139  0.41092850  0.030146350
## sulphates           0.1212510  0.31688435 -0.51970206 -0.151209674
## alcohol             0.1568179  0.52378264  0.13937689  0.394886518
##                            PC9         PC10         PC11
## fixedacidity        0.35393902 -0.275710686  0.342764960
## volatileacidity    -0.49703756  0.151242411  0.079285372
## citricacid         -0.41047402  0.232535464 -0.005864659
## residualsugar       0.08289593  0.002315094  0.444068724
## chlorides           0.29087307 -0.193036254  0.049905503
## freesulfurdioxide   0.37120968  0.484958597  0.002218858
## totalsulfurdioxide -0.31079449 -0.715539149 -0.057662504
## density             0.11545820 -0.009936672 -0.714906569
## pH                  0.12700278 -0.137533920  0.209150183
## sulphates          -0.20824498  0.045792937  0.076414301
## alcohol             0.24596120 -0.203656155 -0.335409887

pcacor_vinhos <- prcomp(vinhos_clusters_padr, scale = TRUE, retx = TRUE)

CP1 <- pcacor_vinhos$x[, 1]
CP2 <- pcacor_vinhos$x[, 2]
CP3 <- pcacor_vinhos$x[, 3]
CP4 <- pcacor_vinhos$x[, 4]
CP5 <- pcacor_vinhos$x[, 5]
CP6 <- pcacor_vinhos$x[, 6]
CP7 <- pcacor_vinhos$x[, 7]
CP8 <- pcacor_vinhos$x[, 8]

par (mfrow=c(1,2))
hist(CP1)
hist(CP2)

hist(CP3)
hist(CP4)

hist(CP5)
hist(CP6)

hist(CP7)
hist(CP8)

pca_vinhos <-cbind(CP1,CP2,CP3,CP4,CP5,CP6,CP7,CP8)

Baseado no gráfico de Variãncia x Componente percebos que por volta de 8 componentes principais a variância diminui bastante, e interpretando os componentes percebos que cada um leva em conta com um peso maior seja positivo ou negativo cerca de 2 a 3 características físico-químicas dos vinhos. Adotaremos então os componentes de 1 a 8.

4.4.2 Clusters Hierárquicos

Assim como o próprio nome diz esta técnica demonstra a hierarquia entre os clusters dentro de um mesmo dataset

hier_cluster<-hclust(dist(vinhos_clusters_padr),method='ward.D2')
d <- dist(vinhos_clusters_padr, method = "euclidean") 
plot(hier_cluster, ylab='distancia', cex=0.6)

groups <- cutree(hier_cluster, k=10) 
rect.hclust(hier_cluster, k=10, border="red") 

groups <- cutree(hier_cluster, k=7) 
rect.hclust(hier_cluster, k=7, border="blue")

Nos baseando nas características físico-químicas dos vinhos encontramos 10 clusters distintos, sendo alguns dele muito menores do que os demais e outros bem abrangentes, faz parte da avaliação compararmos os clusters encontrados com os componentes principais e procurarmos semelhanças. Reduzimos então o número de clusters para 7 (em azul) para que possamos obersvar a hierarquia.

hier_cluster_pca<-hclust(dist(pca_vinhos),method='ward.D2')
d <- dist(pca_vinhos, method = "euclidean") 
plot(hier_cluster_pca, ylab='distancia', cex=0.6)

groups <- cutree(hier_cluster_pca, k=10) 
rect.hclust(hier_cluster_pca, k=10, border="red") 

groups <- cutree(hier_cluster_pca, k=7) 
rect.hclust(hier_cluster_pca, k=7, border="blue")

Existe uma diferença entre os clusters encontrados com os componentes principais e podemos inferir que esse diferença se se deve ao motivo dos componentes não sofrem com a alta correlação entre as variáveis. Podemos observar também que a diferença se repete mesmo quando diminuimos a quantidade de clusters, entretanto, quando usamos os componentes principais é perceptível a existência de apenas um grupo muito pequeno o que não ocorre quando nos baseamos nas variáveis explicativas do dataset.

4.4.3 K-means

É uma técnica não hierárquica que consiste na formação de clusters que agrupem observações a partir de um ponto central baseado na distância da observação ao ponto central, ao fim do k-means as observações estarão clusterizadas em torno do centróido ao qual tem a menor distância.

wss <- (nrow(vinhos_clusters_padr)-1)*sum(apply(vinhos_clusters_padr,2,var))
for (i in 2:100) wss[i] <- sum(kmeans(vinhos_clusters_padr,
                                     centers=i, iter.max = 50)$withinss)
plot(1:100, wss, type="b", xlab="Número de clusters")

Analisando o gráfico acima podemos verificar que com cerca 90 clusters teremos poucas diferenças entre observações que indiquem a existe de um novo cluster com características muito específicas.

set.seed(2019)
output_cluster<-kmeans(vinhos_clusters_padr,90, iter = 50)
cluster_vinho<-output_cluster$cluster

table (cluster_vinho)

## cluster_vinho
##   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18 
##  99 108  62 162  83  57  31  97 117 150  20 109  18  36  74 108 129  56 
##  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36 
##  28  75  43  64  32  49  63  48  63 124 105  70  94  96  52  41  45  90 
##  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54 
##  40  61  98  38  24  80  66  77  85  85  16  68   6  54  91 123  68  46 
##  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72 
##  98 111  77  96 101  20  66  57  20  56  62  30 147  67  83  70  20  95 
##  73  74  75  76  77  78  79  80  81  82  83  84  85  86  87  88  89  90 
##  90  81  71  35  35  95 113 104  53 101  88  73  29 106  27  93 118  83

clusplot(vinhos_clusters_padr, output_cluster$cluster, color=TRUE, shade=TRUE,
         labels=2, lines=0 , cex=0.75)

plotcluster(vinhos_clusters_padr, output_cluster$cluster)

wss <- (nrow(pca_vinhos)-1)*sum(apply(pca_vinhos,2,var))
for (i in 2:100) wss[i] <- sum(kmeans(pca_vinhos,
                                     centers=i, iter.max = 50)$withinss)
plot(1:100, wss, type="b", xlab="Número de clusters")

Podemos observar que executando o k-means com os componentes principais encontramos cerca 80 clusters com tamanhos diferentes dos encontrados anteriormente como podemos ver abaixo.

set.seed(2019)
output_cluster_pca<-kmeans(pca_vinhos,80, iter = 50)
cluster_vinho_pca<-output_cluster_pca$cluster

table (cluster_vinho_pca)

## cluster_vinho_pca
##   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18 
## 127 106  83 195 107  65  56  77 116 171  20 112  21  59  31  88 137  70 
##  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36 
##  31 109  55  66  37  56  78  45  60  97  90  96  97  40  57  46  28  71 
##  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54 
##  45 103  98  81  23  50 135 111  93  59  14  69   5  73 141 131 100  71 
##  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72 
## 173  97  75 104  94  14  84  55  28  70  86  77 151  81  95 152  72 108 
##  73  74  75  76  77  78  79  80 
## 107  87  64  32  35 152 147  53

clusplot(pca_vinhos, output_cluster_pca$cluster, color=TRUE, shade=TRUE, labels=2, lines=0 , cex=0.75)

Concluímos que utilizando os componentes principais teremos um número menor de clusters porém com características que possibilitam uma melhor visualização desses agrupamentos.

Conceitos estatisticos para IA